home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / DevTools / profile < prev    next >
Encoding:
Text File  |  1991-12-02  |  10.3 KB  |  510 lines
  1. \ PROFILE - Real time interrupt based performance analyser.
  2. \
  3. 0 .IF
  4.  
  5. To profile your code enter:
  6.  
  7.     PROFILE   executable forth statement
  8.     
  9. For example:
  10.  
  11.     PROFILE      100,000 BENCH.THING
  12.  
  13. Profile will interrupt the code and increment a "slot"
  14. corresponding to a block of code.  It automatically
  15. adjust the slots to the full dictionary
  16. Profile will print a report of where it spent it's time.
  17. The percentages are % of a slot compared to all slots,
  18. and % of a slot compared to total time including all other tasks.
  19.  
  20. Other words:
  21.  
  22.     PF.ZOOMIN  ( slot# -- , adjust slots to detail a slot )
  23.     PF.ZOOMOUT ( -- , adjust slots to full dictionary )
  24.     PF.WHO     ( slot# -- , print what words are in that slot )
  25.     PF-INT-RATE ( -- addr , variable holding desired intrs/sec )
  26.     PF-%-REPORT ( n -- , threshold percentage to report slot )
  27.  
  28. There is code to scan return stack for PC
  29. Controlling variables are:
  30.  
  31.     PF_NUM_GRAB   ( #cells to grab )
  32.     PF_A7_MIN_OFF ( bytes off A7to start looking )
  33. .THEN
  34.  
  35. \ Uses CIAB Timer B
  36. \
  37. \ Author: Phil Burk
  38. \ Copyright 1989 Phil Burk
  39. \
  40.  
  41. \ 00001 06-jun-91 mdh/plb added Auto.Init
  42. getmodule includes
  43.  
  44. exists? HMSL .IF
  45.     getmodule hmod:hmsl-includes
  46. .THEN
  47.  
  48. decimal
  49. include? ciacrb ju:ciab_rsrc.f
  50. include? msec ju:msec
  51.  
  52. ANEW TASK-PROFILE.F
  53. decimal
  54.  
  55. \ Report results of PROFILE -----------------------------
  56. variable PF-SLOT-SUM
  57. variable PF-SUM-REPORTED
  58. variable PF-INT-RATE
  59. 60 11 * 3 / 1+ pf-int-rate !
  60.  
  61. \ Simple Structure Used by timer interrupt
  62. 128 constant PF_NUM_SLOTS    \ slots for histogram
  63.   6 constant PF_NUM_GRAB    \ number of cells to grab from A7 stack
  64.  40 constant PF_A7_MIN_OFF    \ minimal starting offset to look
  65.  
  66. :STRUCT PFData
  67.     long    pf_a7_off    \ offset into return stack to find PC
  68.     aptr    pf_start    \ starting address, ABSOLUTE
  69.     aptr    pf_shift    \ shift found address
  70.     long    pf_misses    \ count of interrupts outside slot range
  71.     pf_num_slots cells bytes pf_slots
  72. ;STRUCT
  73.  
  74.  
  75. PFData PF-DATA  4 allot ( for safety!!!!!!! )
  76.  
  77. 52 pf-data ..! pf_a7_off    \ default for A1000 under V1.3
  78.  
  79.  
  80. ASM PF.GRAB.STACK  ( -- , peek at return stack )
  81. \ A1 contains pointer to PF-Data structure
  82.     move.l    #[ PF_NUM_GRAB ],D0
  83.     move.l    a7,a0
  84.     adda.l    #[ pf_a7_min_off ],a0    \ start up here
  85.     adda.l    #[ pf_slots ],a1  \ offset to slot area
  86. 1$:    move.l    (a0)+,(a1)+
  87.     dbra.w    d0,1$
  88.     moveq.l    #0,d0
  89.     rts
  90. END-CODE
  91.  
  92. ASM ANALYSE_PC
  93. \ D0 = absolute address
  94. \ A1 = address of PF-DATA
  95.     sub.l    [ pf_start ](a1),d0    \ - starting address
  96.     blt.s    1$                    \ get out if below
  97.     move.l    [ pf_shift ](a1),d1    \ get shift ammount
  98.     asr.l    d1,d0                \ calc offset into pf_slots
  99.     andi.l    #$FFFFFFFC,D0        \ long word align
  100.     cmp.l    #[ pf_num_slots cells ],d0
  101.     bge.s    1$
  102.     adda.l    #[ pf_slots ],a1
  103.     adda.l    d0,a1                \ A1 = slot address
  104.     bra.s    2$
  105.  
  106. 1$:    adda.l    #[ pf_misses ],a1    \ A1 = adddress of PF_MISSES
  107.  
  108. 2$:    move.l    (a1),d0                \ Increment slot or LONG at (a1)
  109.     addq.l    #1,d0
  110.     move.l    d0,(a1)
  111.     rts
  112. END-CODE
  113.  
  114. ASM ASMTEST.PF ( D0:abspc A1:abs:pf-data: -- )
  115.     move.l    tos,A1
  116.     move.l    (dsp)+,d0
  117.     move.l    (dsp)+,tos
  118.     bsr        analyse_pc
  119.     rts
  120. END-CODE
  121.  
  122. : PFTEST ( abspc -- )
  123.     pf-data >abs
  124.     asmtest.pf
  125. ;
  126.  
  127. ASM PF.ANAL.INT
  128.     move.l    (a1),d0    \ offset for A7
  129.     move.l    $0(a7,d0.l),d0    \ get return address
  130.     bsr    analyse_pc    \ analyse
  131.      moveq.l    #0,d0
  132.      rts
  133. END-CODE
  134.  
  135.  
  136. ASM PF.GATHER ( -- , increment appropriate slot )
  137.     addq.l    #1,(a1)     ( increment counter for now )
  138. 1$: moveq.l   #0,d0       ( continue chain )
  139.     rts
  140. END-CODE
  141.  
  142.  
  143. \ ---------------------------------------------------
  144.  
  145. \ CIAB Timer B interface
  146.  
  147. variable CIABB-INTR
  148. 0 constant CLEAR
  149.  
  150. : CIABB.START   ( -- , start real time clock running )
  151.     CIAB ..@ ciacrb
  152.         ciacrbF_RUNMODE comp AND  ( reset that bit )
  153.         ciacrbF_LOAD | ciacrbF_START |
  154.     CIAB ..! ciacrb
  155. ;
  156.  
  157. : CIABB.SET.INTR  ( -- , set interrupt bits )
  158.     CLEAR CIAICRF_TB |  SetICR() drop
  159.     CIAICRF_SETCLR CIAICRF_TB | AbleICR()
  160. ;
  161.  
  162. : CIABB.START.TIMER ( -- , start timer and interrupts )
  163.     CIABB.start
  164.     CIABB.set.intr
  165. ;
  166.  
  167. : CIABB.RESET.INTR ( -- , clear interupts )
  168.     CLEAR CIAICRF_TB |  AbleICR()
  169. ;
  170.  
  171. : CIABB.STOP ( -- , stop timer advance )
  172.     CIAB ..@ ciacrb
  173.         ciacrbF_START comp AND  ( reset that bit )
  174.     CIAB ..! ciacrb
  175. ;
  176.  
  177. : CIABB.STOP.TIMER ( -- , turn off timer )
  178.     CIABB.reset.intr
  179.     CIABB.stop
  180. ;
  181.  
  182. variable CIABB-LATCH  ( cuz the real latch is write only )
  183.  
  184. : CIABB.SET.LATCH  ( count-down-value -- , used to set rate )
  185.     $ FFFF min
  186.     dup CIABB-latch !
  187.     dup $ ff and CIAB ..! ciatblo
  188.     -8 ashift CIAB ..! ciatbhi
  189. ;
  190.  
  191. : CIABB.READ  ( -- count , for testing )
  192.     CIAB ..@ ciatblo
  193.     CIAB ..@ ciatbhi 8 ashift or
  194. ;
  195.  
  196.  
  197. : PF.INSTALL.INT  ( cfa -- ok? , setup interrupt)
  198.     CIAB?   ( open resource )
  199.     CIABB-INTR @ 0=  ( make sure not done twice )
  200.     IF
  201.         MEMF_PUBLIC sizeof() interrupt allocblock ?dup
  202.         IF  
  203.             dup>r CIABB-INTR !  ( save for TERM )
  204. \ Set values in structure.
  205.             NT_INTERRUPT r@ .. is_node ..! ln_type
  206.             127  r@ .. is_node ..! ln_pri
  207.             0" PF CIA Timer" >abs r@ .. is_node ..! ln_name
  208.             pf-data >abs r@ ..! is_data
  209.             ( CFA ) dup >abs r@ ..! is_code
  210. \
  211. \ Add ICR interrupt vector.
  212.             CIAICRB_TB r> addICRVector() dup
  213.             IF ." CIA Interrupt already owned by" cr
  214.                .. is_node ..@ ln_name >rel 0count type cr
  215.                CIABB-INTR @ freeblock
  216.                CIABB-INTR off
  217.                false
  218.             ELSE drop CIABB.start.timer true
  219.             THEN
  220.        ELSE
  221.            ." PF.INSTALL.INT - Not enough space for interrupt!" cr
  222.            false
  223.        THEN
  224.     ELSE true
  225.     THEN
  226.     nip
  227. ;
  228.  
  229. : PF.REMOVE.INT ( -- , remove and free timer interrupt )
  230.     CIABB-INTR @ ?dup
  231.     IF  CIABB.stop.timer
  232.         CIAICRB_TB over remICRVector()
  233.         freeblock
  234.         0 CIABB-INTR !
  235.         0 ciarsrc_lib !
  236.     THEN
  237. ;
  238.  
  239. : pf.RATE@ ( -- ticks/second )
  240.     CIABB-latch @ 0=
  241.     IF 60
  242.     ELSE 715,819 CIABB-latch @ /
  243.     THEN
  244. ;
  245.  
  246. : pf.RATE! ( ticks/second -- )
  247.     dup 11 <
  248.     IF ." 11 = minimum rate!" drop 11
  249.     ELSE   dup 1000 >
  250.         IF ." 1000 = maximum rate!" drop 1000
  251.         THEN
  252.     THEN
  253.     715,819 swap / CIABB.set.latch
  254. ;
  255.  
  256. : PF.INSTALL.ANAL  ( -- ok? , start hardware timer )
  257.     pf.remove.int
  258.     'c pf.anal.int pf.install.int
  259. ;
  260.  
  261. : PF.INSTALL.GRAB  ( -- ok? , start hardware timer )
  262.     pf.remove.int
  263.     'c pf.grab.stack pf.install.int
  264. ;
  265.  
  266. ASM 2LOG  ( N -- log2(N) , calc integer log )
  267.      move.l   #0,d0
  268. 1$:  addq.l   #1,d0
  269.      lsr.l    #1,tos
  270.      bne      1$
  271.      sub.l    #1,d0
  272.      move.l   d0,tos
  273.      rts
  274. END-CODE
  275.  
  276. : PF.SIZE>SHIFT  ( slotsize -- shift )
  277.     1- 2* 2log  ( round up to nearest 2**N )
  278.     2- ( don't shift as much to make cell offset ) 1 max
  279. ;
  280.  
  281. : PF.SHIFT>SIZE  ( shift -- slotsize  )
  282.     2+ 1 swap shift
  283. ;
  284.  
  285. : PF.SET.SCOPE  ( start bucketsize -- )
  286.     pf.size>shift pf-data ..! pf_shift
  287.     >abs pf-data ..! pf_start
  288. ;
  289.  
  290. : PF-SLOT  ( index -- addr )
  291.     cells pf-data .. pf_slots +
  292. ;
  293.  
  294. : PF.CLEAR.SLOTS  ( -- )
  295.     pf_num_slots 0
  296.     DO
  297.         0 i pf-slot !
  298.     LOOP
  299.     0 pf-data ..! pf_misses
  300. ;
  301.  
  302. : PF.MAX.SLOTS  ( -- max )
  303.     0
  304.     pf_num_slots 0
  305.     DO
  306.         i pf-slot @ max
  307.     LOOP
  308. ;
  309.  
  310. : PF.SUM.SLOTS  ( -- sum )
  311.     0
  312.     pf_num_slots 0
  313.     DO
  314.         i pf-slot @ +
  315.     LOOP
  316. ;
  317.  
  318. : PF.SLOT>ABS ( slot# -- absaddr )
  319.     pf-data ..@ pf_shift pf.shift>size *
  320.     pf-data ..@ pf_start +
  321. ;
  322.  
  323. : PF.SLOT>ADDR ( slot# -- reladdr )
  324.     pf.slot>abs >rel
  325. ;
  326.  
  327. : PF.ZOOMIN  ( slot -- )
  328.     pf.slot>addr
  329.     pf-data ..@ pf_shift pf.shift>size
  330.     pf_num_slots / 8 max
  331.     pf.set.scope
  332. ;
  333.  
  334. : PF.ZOOMOUT  ( -- )
  335.     0
  336.     here pf_num_slots /
  337.     pf.set.scope
  338. ;
  339.  
  340. pf.zoomout
  341.  
  342. : AUTO.INIT ( -- )  \ 00001
  343.   AUTO.INIT  pf.zoomout
  344. ;
  345.  
  346. \ Scan dictionary for words in range -------------------
  347. variable PF-LO-ADDR
  348. variable PF-HI-ADDR
  349.  
  350. : PF.WHEN.SCANNED  ( nfa -- , print if within current slot )
  351.     dup>r ( save NFA )
  352.     name>  ( get CFA )
  353.     dup pf-hi-addr @ >  ( does word start above HI )
  354.     IF
  355.         drop
  356.     ELSE
  357.         dup 2- w@ ( get size field ) + ( calc end of word )
  358.         pf-lo-addr @ >
  359.         IF
  360.             4 spaces r@ id. flushemit cr?  \ must overlap
  361.             ?pause
  362.         ELSE
  363. \            ' drop is when-scanned  ( past last possible )
  364.         THEN
  365.     THEN
  366.     rdrop
  367. ;
  368.  
  369. : PF.WHO  ( slot# -- , list words in slot )
  370.     >newline ." Scanning - Please wait!" cr
  371.     dup pf.slot>addr pf-lo-addr !
  372.     1+ pf.slot>addr pf-hi-addr !
  373.     ' pf.when.scanned is when-scanned
  374.     ' drop is when-voc-scanned
  375.     scan-all-vocs cr
  376. ;
  377.  
  378. : PF.REPORT.SLOT  ( i -- )
  379.     dup 3 .r
  380.     base @ >r hex
  381.     ." : $" dup pf.slot>addr 8 .r
  382.     ."  - $" dup 1+ pf.slot>addr 8 .r
  383.     decimal
  384.     ."  = " pf-slot @ dup 8 .r
  385.         dup pf-sum-reported +!
  386.     dup 100 * pf-slot-sum @ /
  387.         ."  = " 3 .r ." % slots"
  388.     100 * pf-slot-sum @ pf-data ..@ pf_misses + /
  389.         ."  = " 3 .r ." % total"
  390.     r> base !
  391.     cr
  392. ;
  393.  
  394.  
  395. : PF.REPORT.SLOTS ( threshold -- , report if above threshold )
  396.     cr
  397.     pf_num_slots 0
  398.     DO
  399.         i pf-slot @
  400.         over >
  401.         IF
  402.             i pf.report.slot
  403.         THEN
  404.     LOOP
  405.     drop
  406.     bl 21 emit-to-column ." Total = "
  407.     pf-slot-sum @        8 .r ."  = "
  408.     pf-sum-reported @ 100 * pf-slot-sum @ /
  409.         3 .r ." % slots = "
  410.     pf-sum-reported @ 100 * pf-slot-sum @
  411.     pf-data ..@ pf_misses + /
  412.         3 .r ." % total"
  413.     cr
  414. ;
  415.  
  416. variable PF-%-REPORT
  417. 5 pf-%-report !
  418.  
  419. : PF.REPORT  ( -- , report all significant slots )
  420.     0 pf-sum-reported !
  421.     pf.sum.slots dup pf-slot-sum !
  422.     pf-%-report @ * 100 /  ( report anything over x% )
  423.     pf.report.slots
  424. ;
  425.  
  426. \ Determine offset on A7 stack for return address -------
  427. 20 max-inline !
  428. here constant AROUND_HERE
  429. : PF.SCAN.ME  ( -- offset | -1 )
  430.     -1
  431.     PF_NUM_GRAB 2*  0
  432.     DO
  433.         pf-data .. pf_slots i 2* + @ >rel
  434.         dup around_here >
  435.         IF
  436.             140 ( = size of PF.SCAN.ME )
  437.             around_here + <
  438.             IF
  439.                 drop i 2* pf_a7_min_off + LEAVE
  440.             THEN
  441.         ELSE drop
  442.         THEN
  443.     LOOP
  444. ;
  445.  
  446. : PF.SCAN.UNTIL ( -- n | -1 )
  447.     -1
  448.     BEGIN
  449.         drop pf.scan.me dup 0<
  450.     WHILE
  451.         ?terminal abort" aborted"
  452.     REPEAT
  453. ;
  454.  
  455. : PF.SCAN.STACK  ( -- , scan stack to determine the A7 offset )
  456.     40 pf.rate!
  457.     pf.install.grab
  458.     100 msec
  459.     IF
  460.         pf.scan.until dup 0>
  461.         IF
  462.             dup >newline ." A7 Offset = " . cr
  463.             dup pf-data ..! pf_a7_off        
  464.         THEN
  465.         drop
  466.         pf.remove.int
  467.     THEN
  468. ;
  469.  
  470. : PF.STATUS  ( -- )
  471.     >newline
  472.     ." Start     = $"
  473.         pf-data ..@ pf_start >rel .hex cr
  474.     ." End       = $"
  475.         pf_num_slots pf.slot>addr .hex cr
  476.     ." Slot Size = $"
  477.         pf-data ..@ pf_shift pf.shift>size .hex cr
  478.     ." HERE      = $"
  479.         here .hex cr
  480.     ." Int Rate  = " pf.rate@  . ." per second" cr
  481. ;
  482.  
  483. : PROFILE  ( -- , start performance analyser )
  484.     pf.scan.stack
  485.     pf.clear.slots
  486.     pf-int-rate @ pf.rate!
  487.     pf.status
  488.     ." Profile begun!" cr
  489.     pf.install.anal
  490.         eol word pad 128 + $move
  491.     IF  ( installed )
  492.         pad 128 + count $interpret
  493.         pf.remove.int
  494.         pf.report
  495.     THEN
  496. ;
  497.  
  498. : PF.TERM ( -- )
  499.     pf.remove.int
  500. ;
  501.  
  502. if.forgotten pf.term
  503.  
  504. true .IF
  505. \ Test it
  506. : EAT* 0 DO 23 45 * drop LOOP ;
  507. ." To test, enter:    PROFILE  100,000 EAT*" cr
  508. .THEN
  509.  
  510.